packages<-c("adehabitatHR","data.table","ggfortify","grid","move","moveVis","OpenStreetMap","pbapply","plotly","rgdal","sp","tidyverse","viridis")
sapply(packages, require, character.only=T)
adehabitatHR data.table ggfortify grid move moveVis OpenStreetMap pbapply
TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
plotly rgdal sp tidyverse viridis
TRUE TRUE TRUE TRUE TRUE
American Mink Dataset
This dataset looked at the American Mink home ranges in Illinois where there habitat has been highly altered.They studied 20 individuals for 6 years (2007-2012) and recorded present. The years in which they studied the minks they had record-breaking drought and flood conditions. They used mark-recapture methods and telemetry to track the individuals.
For this assignment I looked at individuals 1 , 10 and 11
Individual 18: 192 locations
Individual 19: 113 locations
Individual 7: 117 locations
American_Mink <- read_csv("American_Mink.csv")
qaqc_plot <- ggplot() + geom_point(data=American_Mink,
aes(utm_easting,utm_northing,
color=individual_local_identifier)) +
labs(x="Easting", y="Northing") +
guides(color=guide_legend("Identifier"))
ggplotly(qaqc_plot)
lapply(split(American_Mink, American_Mink$individual_local_identifier),
function(x)write.csv(x, file = paste(x$individual_local_identifier[1],".csv"), row.names = FALSE))
$`7`
NULL
$`18`
NULL
$`19`
NULL
files <- c("18 .csv","19 .csv", "7 .csv")
utm_points <- cbind(American_Mink$utm_easting, American_Mink$utm_northing)
utm_locations <- SpatialPoints(utm_points,
proj4string=CRS("+proj=utm +zone=16 +datum=WGS84"))
proj_lat.lon <- as.data.frame(spTransform(
utm_locations, CRS("+proj=longlat +datum=WGS84")))
colnames(proj_lat.lon) <- c("x","y")
raster <- openmap(c(max(proj_lat.lon$y)+0.01, min(proj_lat.lon$x)-0.01),
c(min(proj_lat.lon$y)-0.01, max(proj_lat.lon$x)+0.01),
type = "bing")
raster_utm <- openproj(raster,
projection = "+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs")
autoplot(raster_utm, expand = TRUE) + theme_bw() +
theme(legend.position="bottom") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_point(data=American_Mink, aes(utm_easting,utm_northing,
color=factor(individual_local_identifier)), size = 3, alpha = 0.8) +
theme(axis.title = element_text(face="bold")) + labs(x="Easting",
y="Northing") + guides(color=guide_legend("Identifier"))

Minimum Convex Polygon
library(pbapply)
mcp_raster <- function(filename){
data <- read.csv(file = filename)
x <- as.data.frame(data$utm_easting)
y <- as.data.frame(data$utm_northing)
xy <- c(x,y)
data.proj <- SpatialPointsDataFrame(xy,data , proj4string = CRS("+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs"))
xy <- SpatialPoints(data.proj@coords)
mcp.out <- mcp(xy, percent=100, unout="ha")
mcp.points <- cbind((data.frame(xy)),data$individual_local_identifier)
colnames(mcp.points) <- c("x","y", "identifier")
mcp.poly <- fortify(mcp.out, region = "id")
units <- grid.text(paste(round(mcp.out@data$area,2),"ha"), x=0.85, y=0.95,
gp=gpar(fontface=4, col="white", cex=0.9), draw = FALSE)
mcp.plot <- autoplot(raster_utm, expand = TRUE) + theme_bw() + theme(legend.position="none") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_polygon(data=mcp.poly, aes(x=mcp.poly$long, y=mcp.poly$lat), alpha=0.8) +
geom_point(data=mcp.points, aes(x=x, y=y)) +
labs(x="Easting (m)", y="Northing (m)", title=mcp.points$identifier) +
theme(legend.position="none", plot.title = element_text(face = "bold", hjust = 0.5)) +
annotation_custom(units)
mcp.plot
}
pblapply(files, mcp_raster)
| | 0 % ~calculating
|============================ | 33% ~01s
|======================================================= | 67% ~00s
|==================================================================================| 100% elapsed=01s
[[1]]
[[2]]
[[3]]



Kernel-Density Estimation
kde_raster <- function(filename){
data <- read.csv(file = filename)
x <- as.data.frame(data$utm_easting)
y <- as.data.frame(data$utm_northing)
xy <- c(x,y)
data.proj <- SpatialPointsDataFrame(xy,data, proj4string = CRS("+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs"))
xy <- SpatialPoints(data.proj@coords)
kde<-kernelUD(xy, h="href", kern="bivnorm", grid=100)
ver <- getverticeshr(kde, 75)
kde.points <- cbind((data.frame(data.proj@coords)),data$individual_local_identifier)
colnames(kde.points) <- c("x","y","identifier")
kde.poly <- fortify(ver, region = "id")
units <- grid.text(paste(round(ver$area,2)," ha"), x=0.85, y=0.95,
gp=gpar(fontface=4, col="white", cex=0.9), draw = FALSE)
kde.plot <- autoplot(raster_utm, expand = TRUE) + theme_bw() + theme(legend.position="none") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_polygon(data=kde.poly, aes(x=kde.poly$long, y=kde.poly$lat), alpha = 0.8) +
geom_point(data=kde.points, aes(x=x, y=y)) +
labs(x="Easting (m)", y="Northing (m)", title=kde.points$identifier) +
theme(legend.position="none", plot.title = element_text(face = "bold", hjust = 0.5)) +
annotation_custom(units)
kde.plot
}
pblapply(files, kde_raster)
| | 0 % ~calculating
|============================ | 33% ~00s
|======================================================= | 67% ~00s
|==================================================================================| 100% elapsed=00s
[[1]]
[[2]]
[[3]]



LS0tDQp0aXRsZTogQW1lcmljYW4gbWluayAoTmVvdmlzb24gdmlzb24pIHNwYWNlIHVzZSBpbiBJbGxpbm9pcyAoZGF0YSBmcm9tIEFobGVycyBldCBhbC4gMjAxNSkNCmF1dGhvcjogIkx5cmFuZGEgVGhpZW0iDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgZGZfcHJpbnQ6IHBhZ2VkDQogICAgdG9jOiB5ZXMNCiAgaHRtbF9ub3RlYm9vazoNCiAgICBkZl9wcmludDogcGFnZWQNCiAgICBudW1iZXJfc2VjdGlvbnM6IG5vDQogICAgdGhlbWU6IGpvdXJuYWwgDQogICAgdG9jOiB5ZXMNCiAgICB0b2NfZmxvYXQ6DQogICAgICBjb2xsYXBzZWQ6IG5vDQogICAgICBzbW9vdGhfc2Nyb2xsOiB5ZXMNCiAgcGRmX2RvY3VtZW50OiBkZWZhdWx0DQplZGl0b3Jfb3B0aW9uczoNCiAgY2h1bmtfb3V0cHV0X3R5cGU6IGlubGluZQ0KLS0tDQoNCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCnBhY2thZ2VzPC1jKCJhZGVoYWJpdGF0SFIiLCJkYXRhLnRhYmxlIiwiZ2dmb3J0aWZ5IiwiZ3JpZCIsIm1vdmUiLCJtb3ZlVmlzIiwiT3BlblN0cmVldE1hcCIsInBiYXBwbHkiLCJwbG90bHkiLCJyZ2RhbCIsInNwIiwidGlkeXZlcnNlIiwidmlyaWRpcyIpDQpzYXBwbHkocGFja2FnZXMsIHJlcXVpcmUsIGNoYXJhY3Rlci5vbmx5PVQpDQpgYGANCg0KIyMjIEFtZXJpY2FuIE1pbmsgRGF0YXNldCANCg0KVGhpcyBkYXRhc2V0IGxvb2tlZCBhdCB0aGUgQW1lcmljYW4gTWluayBob21lIHJhbmdlcyBpbiBJbGxpbm9pcyB3aGVyZSB0aGVyZSBoYWJpdGF0IGhhcyBiZWVuIGhpZ2hseSBhbHRlcmVkLlRoZXkgc3R1ZGllZCAyMCBpbmRpdmlkdWFscyBmb3IgNiB5ZWFycyAoMjAwNy0yMDEyKSBhbmQgcmVjb3JkZWQgcHJlc2VudC4gVGhlIHllYXJzIGluIHdoaWNoIHRoZXkgc3R1ZGllZCB0aGUgbWlua3MgdGhleSBoYWQgcmVjb3JkLWJyZWFraW5nIGRyb3VnaHQgYW5kIGZsb29kIGNvbmRpdGlvbnMuIFRoZXkgdXNlZCBtYXJrLXJlY2FwdHVyZSBtZXRob2RzIGFuZCB0ZWxlbWV0cnkgdG8gdHJhY2sgdGhlIGluZGl2aWR1YWxzLiANCg0KRm9yIHRoaXMgYXNzaWdubWVudCBJIGxvb2tlZCBhdCBpbmRpdmlkdWFscyAxICwgMTAgYW5kIDExDQoNCkluZGl2aWR1YWwgMTg6IDE5MiBsb2NhdGlvbnMNCg0KSW5kaXZpZHVhbCAxOTogMTEzIGxvY2F0aW9ucyANCg0KSW5kaXZpZHVhbCA3OiAxMTcgbG9jYXRpb25zIA0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KQW1lcmljYW5fTWluayA8LSByZWFkX2NzdigiQW1lcmljYW5fTWluay5jc3YiKQ0KYGBgDQoNCg0KDQoNCg0KDQpgYGB7cn0NCnFhcWNfcGxvdCA8LSBnZ3Bsb3QoKSArIGdlb21fcG9pbnQoZGF0YT1BbWVyaWNhbl9NaW5rLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYWVzKHV0bV9lYXN0aW5nLHV0bV9ub3J0aGluZywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNvbG9yPWluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllcikpICsNCiAgICAgICAgICAgICAgICAgICAgICAgIGxhYnMoeD0iRWFzdGluZyIsIHk9Ik5vcnRoaW5nIikgKw0KICAgICAgICAgICAgICAgICAgICAgICAgZ3VpZGVzKGNvbG9yPWd1aWRlX2xlZ2VuZCgiSWRlbnRpZmllciIpKQ0KDQpnZ3Bsb3RseShxYXFjX3Bsb3QpDQpgYGANCg0KDQpgYGB7cn0NCmxhcHBseShzcGxpdChBbWVyaWNhbl9NaW5rLCBBbWVyaWNhbl9NaW5rJGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllciksIA0KICAgICAgIGZ1bmN0aW9uKHgpd3JpdGUuY3N2KHgsIGZpbGUgPSBwYXN0ZSh4JGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllclsxXSwiLmNzdiIpLCByb3cubmFtZXMgPSBGQUxTRSkpDQpgYGANCg0KDQpgYGB7cn0NCmZpbGVzIDwtIGMoIjE4IC5jc3YiLCIxOSAuY3N2IiwgIjcgLmNzdiIpDQpgYGANCg0KDQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQp1dG1fcG9pbnRzIDwtIGNiaW5kKEFtZXJpY2FuX01pbmskdXRtX2Vhc3RpbmcsIEFtZXJpY2FuX01pbmskdXRtX25vcnRoaW5nKQ0KdXRtX2xvY2F0aW9ucyA8LSBTcGF0aWFsUG9pbnRzKHV0bV9wb2ludHMsIA0KICAgICAgICAgICAgICAgICBwcm9qNHN0cmluZz1DUlMoIitwcm9qPXV0bSArem9uZT0xNiArZGF0dW09V0dTODQiKSkNCnByb2pfbGF0LmxvbiA8LSBhcy5kYXRhLmZyYW1lKHNwVHJhbnNmb3JtKA0KICAgICAgICAgICAgICAgIHV0bV9sb2NhdGlvbnMsIENSUygiK3Byb2o9bG9uZ2xhdCArZGF0dW09V0dTODQiKSkpDQpjb2xuYW1lcyhwcm9qX2xhdC5sb24pIDwtIGMoIngiLCJ5IikNCnJhc3RlciA8LSBvcGVubWFwKGMobWF4KHByb2pfbGF0LmxvbiR5KSswLjAxLCBtaW4ocHJval9sYXQubG9uJHgpLTAuMDEpLCANCiAgICAgICAgICAgICAgICAgIGMobWluKHByb2pfbGF0LmxvbiR5KS0wLjAxLCBtYXgocHJval9sYXQubG9uJHgpKzAuMDEpLCANCiAgICAgICAgICAgICAgICAgIHR5cGUgPSAiYmluZyIpDQpyYXN0ZXJfdXRtIDwtIG9wZW5wcm9qKHJhc3RlciwgDQogICAgICAgICAgICAgIHByb2plY3Rpb24gPSAiK3Byb2o9dXRtICt6b25lPTE2ICtlbGxwcz1XR1M4NCArdW5pdHM9bSArbm9fZGVmcyIpDQpgYGANCg0KYGBge3J9DQphdXRvcGxvdChyYXN0ZXJfdXRtLCBleHBhbmQgPSBUUlVFKSArIHRoZW1lX2J3KCkgKw0KICB0aGVtZShsZWdlbmQucG9zaXRpb249ImJvdHRvbSIpICsNCiAgdGhlbWUocGFuZWwuYm9yZGVyID0gZWxlbWVudF9yZWN0KGNvbG91ciA9ICJibGFjayIsIGZpbGw9TkEsIHNpemU9MSkpICsNCiAgZ2VvbV9wb2ludChkYXRhPUFtZXJpY2FuX01pbmssIGFlcyh1dG1fZWFzdGluZyx1dG1fbm9ydGhpbmcsDQogICAgICAgICAgICAgY29sb3I9ZmFjdG9yKGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllcikpLCBzaXplID0gMywgYWxwaGEgPSAwLjgpICsNCiAgdGhlbWUoYXhpcy50aXRsZSA9IGVsZW1lbnRfdGV4dChmYWNlPSJib2xkIikpICsgbGFicyh4PSJFYXN0aW5nIiwNCiAgICAgICAgeT0iTm9ydGhpbmciKSArIGd1aWRlcyhjb2xvcj1ndWlkZV9sZWdlbmQoIklkZW50aWZpZXIiKSkNCmBgYA0KDQojIyMgTWluaW11bSBDb252ZXggUG9seWdvbg0KDQpgYGB7cn0NCmxpYnJhcnkocGJhcHBseSkNCm1jcF9yYXN0ZXIgPC0gZnVuY3Rpb24oZmlsZW5hbWUpew0KICBkYXRhIDwtIHJlYWQuY3N2KGZpbGUgPSBmaWxlbmFtZSkNCiAgeCA8LSBhcy5kYXRhLmZyYW1lKGRhdGEkdXRtX2Vhc3RpbmcpDQogIHkgPC0gYXMuZGF0YS5mcmFtZShkYXRhJHV0bV9ub3J0aGluZykNCiAgeHkgPC0gYyh4LHkpDQogIGRhdGEucHJvaiA8LSBTcGF0aWFsUG9pbnRzRGF0YUZyYW1lKHh5LGRhdGEgLCBwcm9qNHN0cmluZyA9IENSUygiK3Byb2o9dXRtICt6b25lPTE2ICtlbGxwcz1XR1M4NCArdW5pdHM9bSArbm9fZGVmcyIpKQ0KICB4eSA8LSBTcGF0aWFsUG9pbnRzKGRhdGEucHJvakBjb29yZHMpDQogIG1jcC5vdXQgPC0gbWNwKHh5LCBwZXJjZW50PTEwMCwgdW5vdXQ9ImhhIikNCiAgbWNwLnBvaW50cyA8LSBjYmluZCgoZGF0YS5mcmFtZSh4eSkpLGRhdGEkaW5kaXZpZHVhbF9sb2NhbF9pZGVudGlmaWVyKQ0KICBjb2xuYW1lcyhtY3AucG9pbnRzKSA8LSBjKCJ4IiwieSIsICJpZGVudGlmaWVyIikNCiAgbWNwLnBvbHkgPC0gZm9ydGlmeShtY3Aub3V0LCByZWdpb24gPSAiaWQiKQ0KICB1bml0cyA8LSBncmlkLnRleHQocGFzdGUocm91bmQobWNwLm91dEBkYXRhJGFyZWEsMiksImhhIiksIHg9MC44NSwgIHk9MC45NSwNCiAgICAgICAgICAgICAgICAgICAgIGdwPWdwYXIoZm9udGZhY2U9NCwgY29sPSJ3aGl0ZSIsIGNleD0wLjkpLCBkcmF3ID0gRkFMU0UpDQogIG1jcC5wbG90IDwtIGF1dG9wbG90KHJhc3Rlcl91dG0sIGV4cGFuZCA9IFRSVUUpICsgdGhlbWVfYncoKSArIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpICsNCiAgICB0aGVtZShwYW5lbC5ib3JkZXIgPSBlbGVtZW50X3JlY3QoY29sb3VyID0gImJsYWNrIiwgZmlsbD1OQSwgc2l6ZT0xKSkgKw0KICAgIGdlb21fcG9seWdvbihkYXRhPW1jcC5wb2x5LCBhZXMoeD1tY3AucG9seSRsb25nLCB5PW1jcC5wb2x5JGxhdCksIGFscGhhPTAuOCkgKw0KICAgIGdlb21fcG9pbnQoZGF0YT1tY3AucG9pbnRzLCBhZXMoeD14LCB5PXkpKSArIA0KICAgIGxhYnMoeD0iRWFzdGluZyAobSkiLCB5PSJOb3J0aGluZyAobSkiLCB0aXRsZT1tY3AucG9pbnRzJGlkZW50aWZpZXIpICsNCiAgICB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiLCBwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGZhY2UgPSAiYm9sZCIsIGhqdXN0ID0gMC41KSkgKyANCiAgICBhbm5vdGF0aW9uX2N1c3RvbSh1bml0cykNCiAgbWNwLnBsb3QNCn0NCg0KcGJsYXBwbHkoZmlsZXMsIG1jcF9yYXN0ZXIpDQpgYGANCg0KDQojIyMgS2VybmVsLURlbnNpdHkgRXN0aW1hdGlvbg0KDQpgYGB7cn0NCmtkZV9yYXN0ZXIgPC0gZnVuY3Rpb24oZmlsZW5hbWUpew0KICBkYXRhIDwtIHJlYWQuY3N2KGZpbGUgPSBmaWxlbmFtZSkNCiAgeCA8LSBhcy5kYXRhLmZyYW1lKGRhdGEkdXRtX2Vhc3RpbmcpDQogIHkgPC0gYXMuZGF0YS5mcmFtZShkYXRhJHV0bV9ub3J0aGluZykNCiAgeHkgPC0gYyh4LHkpDQogIGRhdGEucHJvaiA8LSBTcGF0aWFsUG9pbnRzRGF0YUZyYW1lKHh5LGRhdGEsIHByb2o0c3RyaW5nID0gQ1JTKCIrcHJvaj11dG0gK3pvbmU9MTYgK2VsbHBzPVdHUzg0ICt1bml0cz1tICtub19kZWZzIikpDQogIHh5IDwtIFNwYXRpYWxQb2ludHMoZGF0YS5wcm9qQGNvb3JkcykNCiAga2RlPC1rZXJuZWxVRCh4eSwgaD0iaHJlZiIsIGtlcm49ImJpdm5vcm0iLCBncmlkPTEwMCkNCiAgdmVyIDwtIGdldHZlcnRpY2VzaHIoa2RlLCA3NSkNCiAga2RlLnBvaW50cyA8LSBjYmluZCgoZGF0YS5mcmFtZShkYXRhLnByb2pAY29vcmRzKSksZGF0YSRpbmRpdmlkdWFsX2xvY2FsX2lkZW50aWZpZXIpDQogIGNvbG5hbWVzKGtkZS5wb2ludHMpIDwtIGMoIngiLCJ5IiwiaWRlbnRpZmllciIpDQogIGtkZS5wb2x5IDwtIGZvcnRpZnkodmVyLCByZWdpb24gPSAiaWQiKQ0KICB1bml0cyA8LSBncmlkLnRleHQocGFzdGUocm91bmQodmVyJGFyZWEsMiksIiBoYSIpLCB4PTAuODUsICB5PTAuOTUsDQogICAgICAgICAgICAgICAgICAgICBncD1ncGFyKGZvbnRmYWNlPTQsIGNvbD0id2hpdGUiLCBjZXg9MC45KSwgZHJhdyA9IEZBTFNFKQ0KICBrZGUucGxvdCA8LSBhdXRvcGxvdChyYXN0ZXJfdXRtLCBleHBhbmQgPSBUUlVFKSArIHRoZW1lX2J3KCkgKyB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiKSArDQogICAgdGhlbWUocGFuZWwuYm9yZGVyID0gZWxlbWVudF9yZWN0KGNvbG91ciA9ICJibGFjayIsIGZpbGw9TkEsIHNpemU9MSkpICsNCiAgICBnZW9tX3BvbHlnb24oZGF0YT1rZGUucG9seSwgYWVzKHg9a2RlLnBvbHkkbG9uZywgeT1rZGUucG9seSRsYXQpLCBhbHBoYSA9IDAuOCkgKw0KICAgIGdlb21fcG9pbnQoZGF0YT1rZGUucG9pbnRzLCBhZXMoeD14LCB5PXkpKSArDQogICAgbGFicyh4PSJFYXN0aW5nIChtKSIsIHk9Ik5vcnRoaW5nIChtKSIsIHRpdGxlPWtkZS5wb2ludHMkaWRlbnRpZmllcikgKw0KICAgIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIsIHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoZmFjZSA9ICJib2xkIiwgaGp1c3QgPSAwLjUpKSArIA0KICAgIGFubm90YXRpb25fY3VzdG9tKHVuaXRzKQ0KICBrZGUucGxvdA0KfQ0KDQpwYmxhcHBseShmaWxlcywga2RlX3Jhc3RlcikNCmBgYA0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQo=